home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / music / 7 / modula / gemdem.mod < prev    next >
Text File  |  1985-11-19  |  11KB  |  329 lines
  1. IMPLEMENTATION MODULE GemDem ;
  2.  
  3. (* ----------------------------------------------
  4.  
  5.     GEM demonstration module for TDI Modula-2/ST
  6.  
  7.     (c) TDI Software Ltd. 1985.
  8.  
  9.     The source of this demonstration program is
  10.     included to aid your understanding of the
  11.     Modula-2/ST to GEM interface. For full details
  12.     of the GEM interface please see the Digital
  13.     Research Inc GEM manuals.
  14.  
  15.     The resource file 'GEMDEM.RSC' used by this 
  16.     program was generated by the DR Resource
  17.     Compiler utility. This is available from
  18.     your local Atari dealer.
  19.  
  20.     If you develop any nice demonstration programs
  21.     why not include them in GemDem, and return
  22.     it to us at TDI. We will include it on our
  23.     release disks with acknowlegments to the
  24.     relevent authors.
  25.  
  26.     Happy Modula-2 coding !! 
  27.  
  28.     TDI Modula-2 Development Group. 1985.
  29.  
  30.    ---------------------------------------------- *)
  31.  
  32. FROM SYSTEM IMPORT ADR, ADDRESS ;
  33.  
  34. IMPORT GEMVDIbase, VDIControls, VDIAttribs, VDIOutputs,
  35.        GEMAESbase, AESGraphics, AESMenus, AESForms, AESObjects, AESEvents,
  36.        AESResources, AESWindows, AESApplications ;
  37. IMPORT Fractal, Diamond, Sierpinski, Lines, Cube ;
  38.  
  39.  
  40. CONST (* Object definitions in GEMDEM.RSC from GEMDEM.I *)
  41.   MENU1         =   0 ;     (* TREE *)
  42.   ABOUTBOX      =   1 ;     (* TREE *)
  43.   ALERT1        =   0 ;     (* STRING *)
  44.   DESKMENU      =   3 ;     (* OBJECT IN MENU1 *)
  45.   DEMOMENU      =   4 ;     (* OBJECT IN MENU1 *)
  46.   ABOUTOBJ      =   7 ;     (* OBJECT IN MENU1 *)
  47.   FRACTAL       =  16 ;     (* OBJECT IN MENU1 *)
  48.   SIERPINS      =  17 ;     (* OBJECT IN MENU1 *)
  49.   DIAMONDS      =  18 ;     (* OBJECT IN MENU1 *)
  50.   LINES         =  19 ;     (* OBJECT IN MENU1 *)
  51.   QUIT          =  21 ;     (* OBJECT IN MENU1 *)
  52.   CUBE          =  22 ;     (* OBJECT IN MENU1 *)
  53.   INFOOK        =  4 ;      (* OBJECT IN ABOUTBOX *)
  54.  
  55. VAR 
  56.   VDIHandle : INTEGER ;
  57.   WidthChar, HeightChar, WidthFont, HeightFont : INTEGER ;
  58.  
  59.   (* Window data *)
  60.   Window : INTEGER ;            (* window handle *)
  61.   WindX, WindY, WindWidth, WindHeight : INTEGER ; (* Total window *)
  62.  
  63.   Appl : INTEGER ;
  64.   MenuTree : ADDRESS;
  65.  
  66.  
  67. (* ------------------------------------------------------------------- *)
  68.  
  69. PROCEDURE InitWindow ( VAR Title : ARRAY OF CHAR ) ;
  70. CONST
  71.   Alert = "[3][GemDem currently now works  | with color&mono monitors.][Sorry]";   (* this alert should never show up with mods in place *)
  72.  
  73. VAR 
  74.   i : INTEGER ;
  75.   workIn  : GEMVDIbase.VDIWorkInType ;
  76.   workOut : GEMVDIbase.VDIWorkOutType ;
  77.   maxX, maxY : INTEGER ;
  78.   str : ARRAY [0..70] OF CHAR ;
  79.     
  80. BEGIN
  81.   (* Get AES VDI handle *)
  82.   VDIHandle:=AESGraphics.GrafHandle(WidthChar,HeightChar,WidthFont,HeightFont);
  83.   (* Open VDI Virtual workstation *)
  84.   FOR i := 0 TO 9 DO workIn[i] := 1 ; END ;
  85.   workIn[10] := 2 ; (* Set RC *)
  86.   VDIControls.OpenVirtualWorkstation(workIn,VDIHandle,workOut) ;
  87.   IF workOut[39] (* number of colours *) > 512 THEN
  88.     str := Alert ;  (* 512 was 2 for monochrome  *)
  89.     i := AESForms.FormAlert(1,str) ;
  90.     HALT ;
  91.   END ;
  92.   (* Remove mouse *)
  93.   AESGraphics.GrafMouse(GEMAESbase.MouseOff,NIL) ;
  94.   (* Create space for window *)
  95.   maxX := workOut[0] ; maxY := workOut[1] ;
  96.   Window := AESWindows.WindowCreate(GEMAESbase.Name+GEMAESbase.Closer,10,25,
  97.                                     maxX-40,maxY-50) ;
  98.   (* Draw the window *)
  99.   AESGraphics.GrafGrowBox(10,25,1,1,10,25,maxX-40,maxY-50) ;
  100.   AESWindows.WindowOpen(Window,10,25,maxX-40,maxY-50) ;
  101.   (* Get location of window *)
  102.   AESWindows.WindowGet(Window,GEMAESbase.WorkXYWH,
  103.                        WorkX,WorkY,WorkWidth,WorkHeight) ;
  104.   AESWindows.WindowGet(Window,GEMAESbase.CurrXYWH,
  105.                        WindX,WindY,WindWidth,WindHeight) ;
  106.   (* Set title *)
  107.   AESWindows.WindowSet(Window,GEMAESbase.WindowName,
  108.                        INTEGER(ADR(Title) DIV 10000H),
  109.                        INTEGER(ADR(Title) MOD 10000H),0,0) ;
  110.   (* put back mouse *)
  111.   AESGraphics.GrafMouse(GEMAESbase.MouseOn,NIL) ;
  112.   (* Set fill for blanking operations *)
  113.   i := VDIAttribs.SetFillInteriorStyle(VDIHandle,1) ; (* Set solid fill *)
  114.   i := VDIAttribs.SetFillColour(VDIHandle,GEMAESbase.White) ; (* Set white *)
  115.   (* blank window *)
  116.   ClearWindow ;
  117. END InitWindow ;
  118.  
  119. PROCEDURE CloseWindow ;
  120. VAR
  121.   result : INTEGER ;
  122. BEGIN
  123.   AESWindows.WindowClose(Window) ;
  124.   AESGraphics.GrafShrinkBox(0,0,0,0,WindX,WindY,WindWidth,WindHeight) ;
  125.   AESWindows.WindowDelete(Window) ;
  126. END CloseWindow ;
  127.   
  128. PROCEDURE WaitWindowClosed ;
  129. BEGIN
  130.   Events() ;
  131. END WaitWindowClosed;
  132.  
  133. PROCEDURE ClearWindow ;
  134. VAR rectArray : GEMVDIbase.PxyArrayType ; 
  135. BEGIN
  136.   AESGraphics.GrafMouse(GEMAESbase.MouseOff,NIL) ;
  137.   rectArray[0] := WorkX ;
  138.   rectArray[1] := WorkY ;
  139.   rectArray[2] := WorkX + WorkWidth ;
  140.   rectArray[3] := WorkY + WorkHeight ;
  141.   VDIOutputs.FillRectangle(VDIHandle,rectArray) ;
  142.   AESGraphics.GrafMouse(GEMAESbase.MouseOn,NIL) ;
  143. END ClearWindow ;  
  144.  
  145. (* ------------------------------------------------------------------- *)
  146.  
  147. PROCEDURE DoAboutDialog ;
  148.  
  149. TYPE
  150.   Object = RECORD
  151.              next  : CARDINAL;
  152.              head  : CARDINAL;
  153.              tail  : CARDINAL;
  154.              type  : CARDINAL;
  155.              flags : CARDINAL;
  156.              state : CARDINAL;
  157.              spec  : ADDRESS;
  158.              obx   : CARDINAL;
  159.              oby   : CARDINAL;
  160.              width : CARDINAL;
  161.              depth : CARDINAL;
  162.            END;
  163.   Tree = POINTER TO ARRAY [0..200] OF Object;
  164. VAR
  165.   dTree : ADDRESS ;
  166.   x, y, w, h : INTEGER ;
  167.   result : INTEGER ;
  168.  
  169.   PROCEDURE ObjectAddress(tree : INTEGER; obindex : INTEGER) : ADDRESS;
  170.   VAR res : INTEGER; treeadr : Tree; ob : POINTER TO ADDRESS;
  171.   BEGIN
  172.     AESResources.ResourceGetAddr(0,tree,treeadr);
  173.     RETURN ADR(treeadr^[obindex]);
  174.   END ObjectAddress;
  175.  
  176.   PROCEDURE GetObjectState(tree : INTEGER; obindex : INTEGER) : BITSET;
  177.   VAR res : INTEGER; treeadr : Tree;
  178.   BEGIN
  179.     AESResources.ResourceGetAddr(0,tree,treeadr);
  180.     RETURN BITSET(treeadr^[obindex].state);
  181.   END GetObjectState;
  182.  
  183.   PROCEDURE SetObjectState(tree : INTEGER; obindex : INTEGER; state : BITSET);
  184.   VAR res : INTEGER; treeadr : Tree;
  185.   BEGIN
  186.     AESResources.ResourceGetAddr(0,tree,treeadr);
  187.     treeadr^[obindex].state := INTEGER(state);
  188.   END SetObjectState;
  189.  
  190.  
  191.   PROCEDURE DeselectObject(tree : INTEGER; obindex : INTEGER);
  192.   CONST
  193.     Selected = 0 ;
  194.   VAR b : BITSET;
  195.   BEGIN
  196.     b := GetObjectState(tree,obindex);
  197.     b := b - {Selected};
  198.     SetObjectState(tree,obindex,b);
  199.   END DeselectObject;
  200.  
  201. BEGIN
  202.   AESResources.ResourceGetAddr(GEMAESbase.RTree,ABOUTBOX,dTree) ;
  203.   AESForms.FormCenter(dTree,x,y,w,h) ;
  204.   AESForms.FormDialogue(GEMAESbase.FormStart,0,0,0,0,x,y,w,h) ;
  205.   AESForms.FormDialogue(GEMAESbase.FormGrow,0,0,0,0,x,y,w,h) ;
  206.   AESObjects.ObjectDraw(dTree,0,10,x,y,w,h) ;
  207.   result := AESForms.FormDo(dTree,0) ;
  208.   DeselectObject(ABOUTBOX,INFOOK) ;
  209.   AESForms.FormDialogue(GEMAESbase.FormShrink,0,0,0,0,x,y,w,h) ;
  210.   AESForms.FormDialogue(GEMAESbase.FormFinish,0,0,0,0,x,y,w,h) ;
  211. END DoAboutDialog ;
  212.  
  213. PROCEDURE DoDemo ( VAR Title : ARRAY OF CHAR ; DemoProc : PROC ) ;
  214. BEGIN
  215.   (* disable menu items whilst demo in action *)
  216.   AESMenus.MenuItemEnable(MenuTree,ABOUTOBJ,0) ;
  217.   AESMenus.MenuItemEnable(MenuTree,FRACTAL,0) ;
  218.   AESMenus.MenuItemEnable(MenuTree,SIERPINS,0) ;
  219.   AESMenus.MenuItemEnable(MenuTree,DIAMONDS,0) ;
  220.   AESMenus.MenuItemEnable(MenuTree,LINES,0) ;
  221.   AESMenus.MenuItemEnable(MenuTree,CUBE,0) ;
  222.   AESMenus.MenuItemEnable(MenuTree,QUIT,0) ;
  223.   InitWindow(Title) ;
  224.   AESGraphics.GrafMouse(GEMAESbase.MouseOff,NIL) ;
  225.   DemoProc() ;
  226.   AESGraphics.GrafMouse(GEMAESbase.MouseOn,NIL) ;
  227.   WaitWindowClosed ;
  228.   CloseWindow ;
  229.   (* enable menu items *)
  230.   AESMenus.MenuItemEnable(MenuTree,ABOUTOBJ,1) ;
  231.   AESMenus.MenuItemEnable(MenuTree,FRACTAL,1) ;
  232.   AESMenus.MenuItemEnable(MenuTree,SIERPINS,1) ;
  233.   AESMenus.MenuItemEnable(MenuTree,DIAMONDS,1) ;
  234.   AESMenus.MenuItemEnable(MenuTree,LINES,1) ;
  235.   AESMenus.MenuItemEnable(MenuTree,CUBE,1) ;
  236.   AESMenus.MenuItemEnable(MenuTree,QUIT,1) ;
  237. END DoDemo ;
  238.   
  239.   
  240. (* ------------------------------------------------------------------- *)
  241.  
  242. PROCEDURE Events ;
  243. (* Handle resource events *)
  244. VAR
  245.   result : INTEGER ;
  246.   done : BOOLEAN ;
  247.   pipeBuff : ARRAY [0..9] OF INTEGER ;
  248.  
  249.   PROCEDURE SelectMenu( Menu, Item : INTEGER ) ;
  250.   BEGIN
  251.     CASE Menu OF
  252.       DESKMENU : IF Item = ABOUTOBJ THEN
  253.                    DoAboutDialog ;
  254.                  END                        ;       |
  255.       DEMOMENU : CASE Item OF
  256.                    FRACTAL  : DoDemo("Fractal Tree",Fractal.DoFractal) ; |
  257.                    SIERPINS : DoDemo("Sierpinski Curve",
  258.                                       Sierpinski.DoSierpinski); |
  259.                    DIAMONDS : DoDemo("Diamond",Diamond.DoDiamond); |
  260.                    LINES    : DoDemo("Lines",Lines.DoLines) ; |
  261.                    CUBE     : DoDemo("Cube",Cube.DoCube) ; |
  262.                    QUIT     : done := TRUE ; |
  263.                  ELSE
  264.                  END ;
  265.     ELSE
  266.     END ;
  267.     (* put header back normal*)
  268.     AESMenus.MenuTitleNormal(MenuTree,Menu,1) ;
  269.   END SelectMenu ;
  270.  
  271. BEGIN
  272.   AESGraphics.GrafMouse(GEMAESbase.Arrow,NIL) ; (* put pointing mouse *)
  273.   done := FALSE ;
  274.   REPEAT
  275.     AESEvents.EventMessage(ADR(pipeBuff)) ;
  276.     CASE pipeBuff[0] OF         (* message type *)
  277.       GEMAESbase.MenuSelected   : SelectMenu(pipeBuff[3],pipeBuff[4]) ; |
  278.       GEMAESbase.WindowClosed   : done := TRUE ; |
  279.     ELSE
  280.     END ;
  281.   UNTIL done ;
  282. END Events ;
  283.  
  284.  
  285. (* ------------------------------------------------------------------- *)
  286.  
  287. PROCEDURE InitResource() : BOOLEAN ;
  288. CONST
  289.   ResourceFileName = "gemdem.rsc" ;
  290.   Alert = "[3][ No resource file for Modula-2 ST/GEM Demo ][OK]" ;
  291.  
  292. VAR
  293.   str : ARRAY [0..99] OF CHAR ;
  294.   result : INTEGER ;
  295.  
  296. BEGIN
  297.   Appl := AESApplications.ApplInitialise() ;
  298.   str := ResourceFileName ;
  299.   AESResources.ResourceLoad(str) ;
  300.   IF ( GEMAESbase.AESCallResult = 0 ) THEN
  301.     str := Alert ;
  302.     result := AESForms.FormAlert(1,str) ;
  303.     RETURN FALSE ;
  304.   END ;
  305.   (* enable the menu tree *)
  306.   AESResources.ResourceGetAddr(GEMAESbase.RTree,MENU1,MenuTree) ;
  307.   AESMenus.MenuBar(MenuTree,1) ;
  308.   RETURN TRUE ;
  309. END InitResource ;
  310.  
  311. (* ------------------------------------------------------------------- *)
  312.  
  313. PROCEDURE Terminate ;
  314. BEGIN
  315.   AESMenus.MenuBar(MenuTree,0) ;
  316.   AESResources.ResourceFree() ;
  317.   VDIControls.CloseVirtualWorkstation(VDIHandle) ;  
  318. END Terminate ;
  319. (* ------------------------------------------------------------------- *)
  320.  
  321. VAR
  322.   ch : CHAR ;
  323.  
  324. BEGIN
  325.   IF InitResource() THEN
  326.     Events ;
  327.   END ;
  328. END GemDem.
  329. əəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəə